home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / skk / skk-tree.el.z / skk-tree.el
Encoding:
Text File  |  1998-05-21  |  4.8 KB  |  144 lines
  1. ;;; skk-tree.el --- $BLZ7A<0%G!<%?!<$r;H$C$?JQ49$N$?$a$N%W%m%0%i%`(B
  2. ;; Copyright (C) 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996
  3. ;; Masahiko Sato <masahiko@kuis.kyoto-u.ac.jp>
  4.  
  5. ;; Author: Masahiko Sato <masahiko@kuis.kyoto-u.ac.jp>
  6. ;; Maintainer: Mikio Nakajima <minakaji@osaka.email.ne.jp>
  7. ;; Version: $Id: skk-tree.el,v 1.2 1997/08/24 15:25:58 mrt Exp $
  8. ;; Keywords: japanese
  9. ;; Last Modified: $Date: 1997/08/24 15:25:58 $
  10.  
  11. ;; This program is free software; you can redistribute it and/or modify
  12. ;; it under the terms of the GNU General Public License as published by
  13. ;; the Free Software Foundation; either versions 2, or (at your option)
  14. ;; any later version.
  15.  
  16. ;; This program is distributed in the hope that it will be useful
  17. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19. ;; GNU General Public License for more details.
  20.  
  21. ;; You should have received a copy of the GNU General Public License
  22. ;; along with SKK, see the file COPYING.  If not, write to the Free
  23. ;; Software Foundation Inc., 59 Temple Place - Suite 330, Boston,
  24. ;; MA 02111-1307, USA.
  25.  
  26. ;;; Commentary:
  27.  
  28. ;;; Change log:
  29. ;; version 1.0 released 1996.10.2 (derived from the skk.el 8.6)
  30.  
  31. ;;; Code:
  32. (require 'skk-foreword)
  33. (require 'skk-vars)
  34.  
  35. ;;;###skk-autoload
  36. (defvar skk-rom-kana-rule-tree nil
  37.   "*skk-rom-kana-rule-list $B$NMWAG?t$,B?$/$J$C$?$H$-$K;HMQ$9$k%D%j!<!#(B
  38. .emacs $B$K(B
  39.         (setq skk-rom-kana-rule-tree
  40.               (skk-compile-rule-list skk-rom-kana-rule-list))
  41. $B$rDI2C$9$k(B.
  42.  
  43. $B$3$N$^$^$G$O(B SKK $B$r5/F0$9$k$H$-$KKh2s(B \"skk-compile-rule-list\" $B$r7W;;$9(B
  44. $B$k$3$H$K$J$k$N$G(B, $B$&$^$/$$$/$3$H$,$o$+$l$P(B,
  45.         (skk-compile-rule-list skk-rom-kana-rule-list)
  46. $B$NCM$rD>@\(B .emacs $B$K=q$$$F$*$/$H$h$$!#(B" )
  47.  
  48. ;;;###skk-autoload
  49. (defvar skk-standard-rom-kana-rule-tree nil
  50.   "*skk-standard-rom-kana-rule-list $B$NMWAG?t$,B?$/$J$C$?$H$-$K;HMQ$9$k%D%j!<!#(B
  51. .emacs $B$K(B
  52.         (setq skk-standard-rom-kana-rule-tree
  53.               (skk-compile-rule-list skk-standard-rom-kana-rule-list))
  54. $B$rDI2C$9$k(B.
  55.  
  56. $B$3$N$^$^$G$O(B SKK $B$r5/F0$9$k$H$-$KKh2s(B \"skk-compile-rule-list\" $B$r7W;;$9(B
  57. $B$k$3$H$K$J$k$N$G(B, $B$&$^$/$$$/$3$H$,$o$+$l$P(B,
  58.         (skk-compile-rule-list skk-standard-rom-kana-rule-list)
  59. $B$NCM$rD>@\(B .emacs $B$K=q$$$F$*$/$H$h$$!#(B" )
  60.  
  61. (defvar skk-tree-load-hook nil
  62.   "*skk-tree.el $B$r%m!<%I$7$?8e$K%3!<%k$5$l$k%U%C%/!#(B" )
  63.  
  64. ;; $BF0E*JQ?t!#%P%$%H%3%s%Q%$%i!<$rL[$i$;$k$?$a$K$H$j$"$($:(B nil $B$rBeF~!#(B
  65. (defvar root nil)
  66.  
  67. ;; convert skk-rom-kana-rule-list to skk-rom-kana-rule-tree.
  68. ;; The rule tree follows the following syntax:
  69. ;; <tree> ::= ((<char> . <tree>) . <tree>) | nil
  70. ;; <item> ::= (<char> . <tree>)
  71.  
  72. (defun skk-compile-rule-list (l)
  73.   ;; rom-kana-rule-list $B$rLZ$N7A$K%3%s%Q%$%k$9$k!#(B
  74.   (let (tree rule)
  75.     (while l
  76.       (setq rule (car l)
  77.             l (cdr l)
  78.             tree (skk-add-rule rule tree) ))
  79.     tree))
  80.  
  81. (defun skk-add-rule (rule tree)
  82.   ;; $BGK2uE*$K(B RULE $B$r(B TREE $B$K2C$($k!#(B
  83.   (let* ((str (car rule))
  84.      (char (string-to-char str))
  85.      (rest (substring str 1))
  86.      (rule-body (cdr rule))
  87.      (root tree))
  88.     (skk-add-rule-main char rest rule-body tree)
  89.     root))
  90.  
  91. (defun skk-add-rule-main (char rest body tree)
  92.   (let ((item (skk-search-tree char tree)) (cont t))
  93.     (if item
  94.     (if (string= rest "")
  95.         (setcdr item (cons (cons 0 body) (cdr item)))
  96.       (skk-add-rule-main
  97.        (string-to-char rest) (substring rest 1) body (cdr item)))
  98.       ;; key not found, so add rule to the end of the tree
  99.       (if (null root)
  100.       (setq root (skk-make-rule-tree char rest body))
  101.     (while (and cont tree)
  102.       (if (null (cdr tree))
  103.           (progn
  104.         (setcdr tree (skk-make-rule-tree char rest body))
  105.         (setq cont nil))
  106.         (setq tree (cdr tree))))))))
  107.  
  108. (defun skk-make-rule-tree (char rest body)
  109.   (if (string= rest "")
  110.       (list (cons char (list (cons 0 body))))
  111.     (list
  112.      (cons char
  113.            (skk-make-rule-tree
  114.             (string-to-char rest) (substring rest 1) body)))))
  115.  
  116. (defun skk-search-tree (char tree)
  117.   (let ((cont t) v)
  118.     (while (and cont tree)
  119.       (if (= char (car (car tree)))
  120.           (setq v (car tree)
  121.                 cont nil)
  122.         (setq tree (cdr tree))))
  123.     v))
  124.  
  125. ;;;###skk-autoload
  126. (defun skk-assoc-tree (key tree)
  127.   (let ((char (string-to-char key)) (rest (substring key 1))
  128.         (cont t) v )
  129.     (while (and tree cont)
  130.       (if (= char (car (car tree)))
  131.           (if (string= rest "")
  132.               (setq v (if (= 0 (car (car (cdr (car tree)))))
  133.                           (cdr (car (cdr (car tree)))))
  134.                     cont nil)
  135.             (setq v (skk-assoc-tree rest (cdr (car tree)))
  136.                   cont nil))
  137.         (setq tree (cdr tree))))
  138.     v))
  139.  
  140. (run-hooks 'skk-tree-load-hook)
  141.  
  142. (provide 'skk-tree)
  143. ;;; skk-tree.el ends here
  144.